home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "JOYSTICK"
- Option Explicit
- '-------------------------------------------------------
- ' JOYSTICK.BAS - Joystick support routines for
- ' Visual Basic.
- '-------------------------------------------------------
-
- ' Joystick Device ID
- Global Const JOYSTICK1 = 0
- Global Const JOYSTICK2 = 1
-
- ' Joystick error return values
- Global Const JOYERR_NOERROR = 0
- Global Const JOYERR_PARMS = 165
- Global Const MMSYSERR_NODRIVER = 6
- Global Const JOYERR_UNPLUGGED = 167
-
- ' Joystick button bit-flags used by tJoyInfo.ButtonStates
- Global Const JOY_BUTTON1 = &H1
- Global Const JOY_BUTTON2 = &H2
- Global Const JOY_BUTTON3 = &H4
- Global Const JOY_BUTTON4 = &H8
-
-
- ' Joystick Position
- Type tJoyInfo
- Xin As Integer
- Yin As Integer
- Zin As Integer
- ButtonStates As Integer
-
- ' These values are determined by the fields above.
- X As Long
- Y As Long
- Z As Long
- ButtonDown(1 To 4) As Integer
- End Type
-
- ' Joystick Capabilities
-
- Const MAXPNAMELEN = 32
-
- Type tJoyCaps
- Mid As Integer
- Pid As Integer
- Pname As String * MAXPNAMELEN
- XminIn As Integer
- XmaxIn As Integer
- YminIn As Integer
- YmaxIn As Integer
- ZminIn As Integer
- ZmaxIn As Integer
- NumButtons As Integer
- PeriodMin As Integer
- PeriodMax As Integer
-
- Xmin As Long
- Xmax As Long
- Ymin As Long
- Ymax As Long
- Zmin As Long
- Zmax As Long
- End Type
-
- Global JoyCaps As tJoyCaps
-
- ' Joystick API Calls
- Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As tJoyCaps, ByVal uSize As Long) As Long
- Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As tJoyInfo) As Long
-
-
- Function GetJoyStickPos(IDDevice As Integer, JoyInfo As tJoyInfo) As Integer
- '-------------------------------------------------------
- ' This function is a wrapper around the joyGetPos API
- ' call. That call returns coordinates as unsigned
- ' long integers, which VB doesn't support. We move
- ' these coordinates into long values so that they
- ' can be easily evaluated.
- '-------------------------------------------------------
- Dim rc As Integer
- Static NotFirstTime As Integer
-
- If Not NotFirstTime Then
- NotFirstTime = False
- rc = joyGetDevCaps(IDDevice, JoyCaps, Len(JoyCaps))
-
- If rc <> 0 Then
- GetJoyStickPos = rc
- Exit Function
- End If
-
- JoyCaps.Xmax = uint_to_long(JoyCaps.XmaxIn)
- JoyCaps.Xmin = uint_to_long(JoyCaps.XminIn)
- JoyCaps.Ymax = uint_to_long(JoyCaps.YmaxIn)
- JoyCaps.Ymin = uint_to_long(JoyCaps.YminIn)
- JoyCaps.Zmax = uint_to_long(JoyCaps.ZmaxIn)
- JoyCaps.Zmin = uint_to_long(JoyCaps.ZminIn)
-
- End If
-
- rc = joyGetPos(IDDevice, JoyInfo)
- GetJoyStickPos = rc
-
- If rc <> 0 Then Exit Function
-
- JoyInfo.X = uint_to_long(JoyInfo.Xin)
- JoyInfo.Y = uint_to_long(JoyInfo.Yin)
- JoyInfo.Z = uint_to_long(JoyInfo.Zin)
-
- JoyInfo.ButtonDown(1) = (JoyInfo.ButtonStates And JOY_BUTTON1) = JOY_BUTTON1
- JoyInfo.ButtonDown(2) = (JoyInfo.ButtonStates And JOY_BUTTON2) = JOY_BUTTON2
- JoyInfo.ButtonDown(3) = (JoyInfo.ButtonStates And JOY_BUTTON3) = JOY_BUTTON3
- JoyInfo.ButtonDown(4) = (JoyInfo.ButtonStates And JOY_BUTTON4) = JOY_BUTTON4
-
- End Function
-
- Function uint_to_long(uint As Integer) As Long
- '-------------------------------------------------------
- ' Convert and unsigned integer into a long integer.
- '-------------------------------------------------------
-
- uint_to_long = (CLng(uint) And &HFFFF&)
- End Function
-
-